home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / AMICUS / AMICUS24.ADF / bmon / BMon (.txt) next >
AmigaBASIC Source Code  |  1988-04-16  |  10KB  |  492 lines

  1. '(C) Sten Linnarsson
  2.  
  3.  
  4. 'Try these sequences:
  5. '
  6. '=FC0000r10s+    Will show beginning of 
  7. '                kickstart (;kick)
  8. '
  9. ';intu;nnam      Shows intuition name
  10. ';offs           Blanks the pointer
  11. ';exec;scan      Shows some libnodes
  12.  
  13. 'Otherwise, use trial-and-error. If you
  14. 'find a bug, then correct it! Use this
  15. 'program in any way you wish, as long
  16. 'as you don't think I would mind. If
  17. 'you think I would, then don't do it!
  18.  
  19.  
  20.  
  21.  
  22.  
  23.  
  24.  
  25.  
  26.  
  27.  
  28.  
  29.  
  30.  
  31.  
  32.  
  33.  
  34.  
  35.  
  36. Init:
  37. DIM com$(50,3),p%(3),d$(15)
  38. temp#=0
  39. l=1
  40. s$=";exec" 'Auto-execute exec
  41. C$=""
  42. errcont=0  'break on error
  43. align=0    'no align
  44. version$="v3.0"
  45.  
  46. 'For command-interpreter
  47. com$(0,1)="dummy string"
  48. i=0
  49. READ com$(i,1),com$(i,2),com$(i,3)
  50. WHILE com$(i,1)<>"NULL"
  51.   i=i+1
  52.   READ com$(i,1),com$(i,2),com$(i,3)
  53. WEND
  54. maxcom=i-1
  55.  
  56. 'For tiny disassembler
  57. FOR i=0 TO 15
  58.   READ d$(i)
  59. NEXT
  60.  
  61. WINDOW 3,,,0
  62. 'Temporary background window
  63.  
  64. WINDOW CLOSE 1
  65. POKEW 14676118,32
  66.  
  67. GOSUB CopyrightNotice
  68. 'Display a *fancy* logo with 
  69. 'copyright notice...
  70.  
  71. 'Now wait for click.
  72. WHILE MOUSE(0)=0:WEND
  73. WHILE MOUSE(0)=1:WEND
  74.  
  75. 'And poke DMACON to show pointer
  76. POKEW 14676118,32800
  77.  
  78. WINDOW 2," ",(389,0)-(631,186),16
  79.  
  80.     PRINT "g  JSR to current ad"
  81.     PRINT ";  Execute command"
  82.     PRINT "r  Repeat command"
  83.     PRINT "=  Change ad"
  84.     PRINT "!  Change byte at ad"
  85.     PRINT "@  Change word at ad"
  86.     PRINT "#  Change long at ad"
  87.     PRINT "<  Decrement ad"
  88.     PRINT ">  Increment ad"
  89.     PRINT "+  Increment one frame"
  90.     PRINT "-  Decrement one frame"
  91.     PRINT "w  Advance a word '>>'"
  92.     PRINT "l  Advance a long '>>>>'"
  93.     PRINT "j  Jump to offset"
  94.     PRINT "u  Jump back (unjump)"
  95.     PRINT "h  Show a frame of hex"
  96.     PRINT "s  Show a frame of text"
  97.     PRINT "c  Show commands"
  98.     PRINT "?  Information"
  99.     PRINT "q  Quits"
  100.  
  101. WINDOW 1,"BMON "+version$+" by Sten Linnarsson",(0,0)-(382,186),16
  102.  
  103. WINDOW CLOSE 3
  104.  
  105. Menus:
  106.  
  107. MENU 5,0,1,"BMON  "+version$
  108. MENU 5,1,2,"   ErrBrk   "
  109. MENU 5,2,1,"   ErrCont  "
  110. MENU 5,3,0,"            "
  111. MENU 5,4,2,"   BrkTrap  "
  112. MENU 5,5,1,"   NoBrkTrap"
  113. MENU 5,6,0,"            "
  114. MENU 5,7,2,"   NoAlign  "
  115. MENU 5,8,1,"   AlignText"
  116. ON MENU GOSUB MenuHandle
  117. MENU ON
  118.  
  119. ON BREAK GOSUB BreakHandle
  120. BREAK ON
  121.  
  122. Loop:
  123. C$=MID$(s$,1,1)
  124. s$=MID$(s$,2,LEN(s$))
  125. IF C$<>"" THEN
  126.  
  127. ComGo:  
  128.   IF C$="g" THEN 
  129.     INPUT "Are you sure ?";yesno$
  130.     IF yesno$="yes" THEN CALL ad#
  131.   END IF
  132.  
  133. ComIgnore:
  134.   IF C$="'" THEN
  135.     s$=""
  136.   END IF
  137.   
  138. ComSetAd:    
  139.   IF C$="=" THEN
  140.     IF LEN(LEFT$(s$,6))=6 THEN
  141.       ToHex(LEFT$(s$,6))
  142.       ad#=dec&
  143.       s$=RIGHT$(s$,LEN(s$)-6)
  144.     ELSE
  145.       INPUT "ad= ",a$
  146.       ToHex(a$)
  147.       IF LEN(a$)<=6 THEN ad#=dec&
  148.     END IF
  149.   END IF
  150.  
  151. ComInfo:  
  152.   IF C$="?" THEN
  153.     PRINT "BMON ";version$
  154.     PRINT "(C) Sten Linnarsson"
  155.     PRINT
  156.     PRINT "This software is in the "
  157.     PRINT "Public Domain. It may be "
  158.     PRINT "duplicated ONLY if "
  159.     PRINT
  160.     PRINT "1 The copyright screen is unchanged" 
  161.     PRINT "2 You do not profit"
  162.     PRINT "3 The first line reads '(C) Sten Linnarsson'" 
  163.   END IF
  164.  
  165. ComList:      
  166.   IF C$="c" THEN
  167.     FOR i=0 TO maxcom
  168.       PRINT com$(i,1);"  ";com$(i,3)
  169.     NEXT
  170.   END IF
  171.   
  172. ComIncDec:  
  173.   IF C$="<" THEN ad#=ad#-1
  174.   IF C$="-" THEN ad#=ad#-16
  175.   IF C$="+" THEN ad#=ad#+16
  176.   IF C$=">" THEN ad#=ad#+1
  177.   IF C$="w" THEN ad#=ad#+2
  178.   IF C$="l" THEN ad#=ad#+4
  179.  
  180. ComExecute:  
  181.   IF C$=";" THEN
  182.     FOR i=0 TO maxcom
  183.       IF LEFT$(s$,4)=com$(i,1) THEN s$=com$(i,2)+RIGHT$(s$,LEN(s$)-4)
  184.     NEXT
  185.   END IF
  186.   
  187. ComJump:  
  188.   IF C$="j" THEN
  189.     UnJump#=ad#
  190.     IF PEEKL(ad#)<=5.42414e-315 THEN
  191.       ad#=PEEKL(ad#)
  192.     ELSE
  193.       PRINT "Address out of range"
  194.       PRINT "Higher than $FFFFF0, 16777205"  
  195.       IF errcont=0 THEN s$="":Repeat=0:GOTO Loop
  196.     END IF
  197.   END IF
  198.   
  199. ComUnJump:
  200.   IF C$="u" THEN
  201.     temp#=ad#
  202.     ad#=UnJump#
  203.     UnJump#=temp#
  204.   END IF 
  205.    
  206. ComPoke:
  207.   IF C$="!" THEN
  208.     IF LEN(LEFT$(s$,2))=2 THEN
  209.       ToHex(LEFT$(s$,2))
  210.       POKE ad#,dec&
  211.       s$=RIGHT$(s$,LEN(s$)-2)
  212.     ELSE
  213.       INPUT "byte= ",a$
  214.       IF a$<>"" THEN
  215.         ToHex(a$)
  216.         POKE ad#,dec&
  217.       END IF
  218.     END IF
  219.   END IF
  220.  
  221. 'Does not check for even-byte address
  222.   IF C$="@" THEN
  223.     IF LEN(LEFT$(s$,4))=4 THEN
  224.       ToHex(LEFT$(s$,4))
  225.       POKEW ad#,dec&
  226.       s$=RIGHT$(s$,LEN(s$)-4)
  227.     ELSE
  228.       INPUT "word= ",a$
  229.       IF a$<>"" THEN
  230.         ToHex(a$)
  231.         POKEW ad#,dec&
  232.       END IF
  233.     END IF
  234.   END IF
  235.  
  236. 'Does not check for even-byte address  
  237.   IF C$="#" THEN
  238.     IF LEN(LEFT$(s$,8))=8 THEN
  239.       ToHex(LEFT$(s$,8))
  240.       POKEL ad#,dec&
  241.       s$=RIGHT$(s$,LEN(s$)-8)
  242.     ELSE
  243.       INPUT "long= ",a$
  244.       IF a$<>"" THEN
  245.         ToHex(a$)
  246.         POKEL ad#,dec&
  247.       END IF
  248.     END IF
  249.   END IF
  250.  
  251. ComHex:  
  252.   IF C$="h" THEN
  253.     PRINT HEX$(ad#);": ";
  254.     FOR i=0 TO 15  
  255.       x$=HEX$(PEEK(ad#+i))
  256.       IF LEN(x$)=1 THEN x$="0"+x$
  257.       PRINT x$;
  258.       PRINT PTAB(WINDOW(4)+2);
  259.     NEXT
  260.     PRINT 
  261.   END IF
  262.  
  263. ComText:  
  264.   IF C$="s" THEN
  265.     PRINT HEX$(ad#);": ";
  266.     PRINT PTAB(WINDOW(4)+4);
  267.     FOR i=0 TO 15
  268.       x=PEEK(ad#+i)
  269.       IF x<32 OR x>126 THEN x=95
  270.       PRINT CHR$(x);
  271.       IF align=1 THEN PRINT PTAB(WINDOW(4)+10);
  272.     NEXT
  273.     PRINT
  274.   END IF
  275.  
  276. ComRepeat:
  277.   IF C$="r" THEN Repeat=VAL(LEFT$(s$,2))-1:s$=RIGHT$(s$,LEN(s$)-2):r$=s$
  278.  
  279. ComQuit:
  280.   IF C$="q" THEN
  281.     PRINT "Quitting..."
  282.     END
  283.   END IF
  284.   
  285.  
  286. ELSE
  287.   IF Repeat>1 THEN
  288.     s$=r$
  289.     Repeat=Repeat-1
  290.   ELSE
  291.     PRINT HEX$(ad#);
  292.     INPUT "> ",s$
  293.   END IF
  294. END IF
  295.  
  296. GOTO Loop
  297.  
  298. MenuHandle:
  299. IF MENU(0)=5 THEN
  300.   MENU OFF
  301.   IF MENU(1)=1 THEN 
  302.     MENU 5,1,2
  303.     MENU 5,2,1
  304.     errcont=0
  305.   END IF
  306.   IF MENU(1)=2 THEN
  307.     MENU 5,1,1
  308.     MENU 5,2,2
  309.     errcont=1
  310.   END IF
  311.   IF MENU(1)=4 THEN
  312.     MENU 5,4,2
  313.     MENU 5,5,1
  314.     BREAK ON
  315.   END IF
  316.   IF MENU(1)=5 THEN
  317.     MENU 5,4,1
  318.     MENU 5,5,2
  319.     BREAK OFF
  320.   END IF
  321.   IF MENU(1)=7 THEN
  322.     MENU 5,7,2
  323.     MENU 5,8,1
  324.     align=0
  325.   END IF
  326.   IF MENU(1)=8 THEN
  327.     MENU 5,7,1
  328.     MENU 5,8,2
  329.     align=1
  330.   END IF
  331.   MENU ON
  332. END IF
  333. RETURN
  334.  
  335. BreakHandle:
  336.  
  337. PRINT "^C --- Break Trap Set"
  338. RETURN
  339.  
  340.  
  341. CopyrightNotice:
  342. type=0
  343. WHILE type<>-1
  344.   READ type
  345.   IF type=1 THEN
  346.     READ x1,y1,x2,y2,co
  347.     LINE (x1,y1)-(x2,y2),co,bf
  348.   END IF
  349.   IF type=2 THEN   
  350.     READ x1,y1,x2,y2,co
  351.     LINE (x1,y1)-(x2,y2),co
  352.   END IF
  353.   IF type=3 THEN
  354.     READ x,y,r,C
  355.     CIRCLE (x,y),r,C
  356.   END IF
  357.   IF type=4 THEN  
  358.     READ x,y,co
  359.     PAINT (x,y),co
  360.   END IF
  361.   IF type=5 THEN
  362.     READ x,y,cf,cb,txt$
  363.     LOCATE y,x
  364.     COLOR cf,cb
  365.     PRINT txt$;
  366.   END IF
  367.   IF type=6 THEN
  368.     READ p%(0),p%(1),p%(2),p%(3),lpat    
  369.     PATTERN lpat,p%
  370.   END IF
  371.   IF type=7 THEN
  372.     READ x1,y1,x2,y2,co
  373.     LINE (x1,y1)-(x2,y2),co,b
  374.   END IF  
  375. WEND
  376. 'Hide pointer. (Sometimes causes a
  377. 'tall strip to show. No harm though.)
  378. POKEW 14676118,33024
  379. RETURN
  380.  
  381. 'ToHex(hexstring)
  382. '
  383. 'Note that this sub converts hex to dec
  384. 'and NOT dec to hex as its name suggest
  385. '(Name kept for historical reasons)
  386. 'uses lowercase chars
  387. 'returns the decimal value in 'dec&'
  388.  
  389. SUB ToHex(value$) STATIC
  390. SHARED dec&
  391.  
  392.  
  393. h$="0123456789abcdef"
  394. dec&=0
  395. FOR i=1 TO LEN(value$)
  396.   dec&=dec&*16
  397.   dec&=dec&+INSTR(h$,MID$(value$,i,1))-1
  398. NEXT
  399.  
  400.  
  401. END SUB
  402.  
  403. 'command format:  NAME,string,info
  404.  
  405. Commands:
  406.  
  407. DATA "exec","=000000lj","Jumps to ExecBase structure"
  408. '(Peeks location 4 for offset. 4 is AbsExecBase
  409. DATA "libr","ll>>l>>wwwwllw","Skip 1 Library structure"
  410. DATA "node","ll>>l","Skip 1 node structure"
  411. DATA "intv","lll","Skip 1 IntVector structure"
  412. DATA "task",";exec;libr wwlllllllllllwr16;intv","Go to *ThisTask"
  413. DATA "list","lllwww>> wwl llllw","Go from *ThisTask to MemList"
  414. DATA "slst","lll>>","Skip 1 List structure"
  415. DATA "nnam","ll>>js","Show node name"
  416. DATA "kick","=f80000r13s+","Show start of kick mem"
  417. DATA "intu",";exec r04j","Go to IntuitionBase"
  418. DATA "scan","r10;nnamu<<<<<<<<<<j","Scans next 10 nodes in list"
  419. DATA "offs","=dff096r10@0020","Turn sprite DMA off"
  420. DATA "offd","=dff096r10@0100","Turn display DMA off"
  421. DATA "kill","=000008r10#00000000l","Kill system (VERY fun!)"
  422. DATA "NULL","?","End-of-commands"
  423. 'Should always be the last command
  424.  
  425. DisData:
  426. 'Tiny disassembler
  427. 'examines bits 12-15
  428. 'for op-code general type. 
  429. 'See 'Programming the 68000' pp. 500
  430.  
  431. DATA "Bit manipulation/MOVEP/Immediate"
  432. DATA "Move Byte"
  433. DATA "Move Long"
  434. DATA "Move Word"
  435. DATA "Miscellaneous"
  436. DATA "ADDQ/SUBQ/Scc/DBcc"
  437. DATA "Bcc/BSR"
  438. DATA "MOVEQ"
  439. DATA "OR/DIV/SBCD"
  440. DATA "SUB/SUBX"
  441. DATA "(unassigned)"
  442. DATA "CMP/EOR"
  443. DATA "AND/MUL/ABCD/EXG"
  444. DATA "ADD/ADDX"
  445. DATA "ASL/ASR/ROL/ROR/ROXL/ROXR"
  446. DATA "(unassigned)"
  447.  
  448.  
  449.  
  450. CopyrightData:
  451. 'format:
  452. 'a number specifying the type of the
  453. 'data, followed by the actual data 
  454.  
  455. 'Types:
  456. '     -1   end of data
  457. '      1   filled box
  458. '      2   line
  459. '      3   circle
  460. '      4   paint
  461. '      5   text
  462. '      6   pattern
  463. '      7   empty box
  464.  
  465. DATA 1,50,50,590,150,3
  466. DATA 7,50,50,590,150,2
  467. DATA 3,320,100,90,2
  468. DATA 6,&hf0f0,&ha6a6,&h5555,&h3333,&hffff
  469. DATA 4,600,150,2
  470. DATA 6,&hff00,&h0ff0,&h00ff,&hf00f,&hffff
  471. DATA 4,320,100,2
  472. DATA 5,37,1,1,2,"BMON"
  473. DATA 5,25,3,3,2,"The system structure monitor"
  474. DATA 5,25,4,3,2,"Developed by Sten Linnarsson"
  475.  
  476. VersionNumber:
  477. DATA 5,33,13,1,0,"v3.0 17-Sep-1987"
  478. DATA 5,30,20,0,1,"Press mouse button..."
  479. DATA 5,10,11,1,3,"This program is"
  480. DATA 5,10,12,1,3,"Public Domain."
  481. DATA 5,10,13,1,3,"Type ? for more"
  482. DATA 5,10,14,1,3,"info about this"
  483. DATA 5,10,15,1,3,"type of software."
  484. DATA 5,54,11,1,3,"Sten Linnarsson"
  485. DATA 5,54,12,1,3,"Vintertullstorget 20"
  486. DATA 5,54,13,1,3,"S-116 43 Stockholm"
  487. DATA 5,54,14,1,3,"Sweden"
  488. DATA 5,54,15,1,3,"08/7149564"
  489.  
  490. DATA -1
  491.  
  492.